HPAVC/HPAVC CD-ROM.iso/pc/BPC-DE10.ZIP/INITPORT.PAS

Pascal/Delphi Source File | 1995-09-05 | 5.6 KB | 253 lines

{*******************************************************}
{                                                       }
{       Turbo Pascal Version 7.0                        }
{       BBS Doors Support Unit                          }
{                                                       }
{       Copyright (c) 1995 by Solar Designer            }
{                                                       }
{*******************************************************}

unit InitPort;
{$G+}
interface
uses
   Fossil, SendANSI,
   BIOSKeys;

var
   LocalMode       :Boolean;
   Port            :TFossilPort;

const
   VStr =          '1.0';

   CopyrightASCII  :PChar =
   #13#10'Doors Engine  Version '+VStr+'  Copyright (c) 1995 by Solar Designer \ BPC'#13#10#13#10'$';

   CopyrightANSI =
   #13#10#27'[0m'#27'[1mD'#27'[0moors '#27'[1mE'#27'[0mngine  '#27'[1mV'#27'[0mersion '+VStr+
   '  '#27'[1mC'#27'[0mopyright (c) 1995 by '+
   #27'[1m'#27'[33mS'#27'[37molar '#27'[33mD'#27'[37mesigner \ BPC'#27'[0m'#13#10;

const
   TimeUsed        :LongInt= 0;
   TimeLimit       :LongInt= 0;
   TimeLeftMsg     :PChar =
   ' Time left: 000 minutes ';

procedure Abort(Msg                    :PChar);

function  GetEvent                               :Word;

implementation

const
   Keys            :Array [#1..#32] of Word = (
   kbCtrlA, kbCtrlB, kbCtrlC, kbCtrlD, kbCtrlE, kbCtrlF, kbCtrlG, kbBack,
   kbTab, kbCtrlEnter, kbCtrlK, kbCtrlL, kbEnter, kbCtrlN, kbCtrlO, kbCtrlP,
   kbCtrlQ, kbCtrlR, kbCtrlS, kbCtrlT, kbCtrlU, kbCtrlV, kbCtrlW, kbCtrlX,
   kbCtrlY, kbCtrlZ, kbEsc, 28, 29, 30, 31, kbSpace);

   ArrowKeys       :Array ['A'..'D'] of Word = (
   kbUp, kbDown, kbRight, kbLeft);

   EscTime =       4;

procedure SendChar(c                   :Char); far;
begin
   Port.SendChar(c);
end;

function  CD                                     :Boolean; far;
begin
   CD:=Port.CarrierDetect;
end;

var
   LastExitProc    :Pointer;

procedure PortExitProc; far;
begin
   if not LocalMode then
   begin
      DoneSendANSI; Port.Done;
   end;
   ExitProc:=LastExitProc;
end;

function  GetEvent;
label
   LocalKey, W8Key;
var
   c               :Char;
   Timer           :LongInt absolute 0:$46C;
   W8Timer, W8i    :Byte;
   Time            :Word;
const
   UpdateTimer     :LongInt= MaxLongInt;
begin
   if LocalMode then
   asm
LocalKey:
      xor  ax,ax
      int  16h
      leave
      ret
   end;

W8Key:
   if not Port.CarrierDetect then
      Abort('Carrier lost'#13#10'$');
   asm
      mov  ah,1
      int  16h
      jnz  LocalKey
   end;

   Time:=(TimeLimit-TimeUsed) div (6*182)+1;

   asm
      mov  ax,Time
      mov  cx,3
      mov  si,word ptr TimeLeftMsg
@@NextDigit:
      cwd
      mov  bx,10
      div  bx
      mov  bx,dx
      or   bx,ax
      jnz  @@Not0
      mov  dl,' '
      jmp  @@SaveDigit
@@Not0:
      add  dl,'0'
@@SaveDigit:
      mov  byte ptr [si+14],dl
      dec  si
      loop @@NextDigit

      les  di,ScreenAddr
      imul bx,ScreenWidth,2*23
      lea  di,[di+bx+2*2]
      mov  si,word ptr TimeLeftMsg
      mov  ah,0Fh
      cld
@@NextChar:
      lodsb
      or   al,al
      jz   @@Done
      stosw
      jmp  @@NextChar
@@Done:
   end;

   if Timer<>UpdateTimer then UpdateSendANSI;
   asm cli end;
   if Timer>UpdateTimer then Inc(TimeUsed, Timer-UpdateTimer);
   UpdateTimer:=Timer;
   asm sti end;

   if TimeUsed>TimeLimit then
   begin
      DoneSendANSI;
      Port.SendString('Time limit'#13#10);
      Port.Done;
      ExitProc:=LastExitProc;
      Abort('Time limit'#13#10'$');
   end;

   if Port.CharAvail then
   begin
      c:=Port.ReceiveChar;
      case c of
         #127:
            GetEvent:=kbBack;
         #33..#255:
            GetEvent:=Byte(c);
         #27:
         begin
            for W8i:=0 to EscTime do
            begin
               W8Timer:=Byte(Timer);
               while (Byte(Timer)=W8Timer) and (not Port.CharAvail) do;
            end;

            if Port.PreviewChar<>'[' then GetEvent:=kbEsc else
            begin
               Port.ReceiveChar;
               c:=Port.ReceiveChar;
               case c of
                  'A'..'D':
                     GetEvent:=ArrowKeys[c];
                  else
                     GoTo W8Key;
               end;
            end;
         end;
         #1..#32:
            GetEvent:=Keys[c];
         else
            GoTo W8Key;
      end;
   end else GoTo W8Key;
end;

procedure Abort;
begin
   asm
      mov  si,word ptr Msg
      cmp  byte ptr [si],1
      je   @@NoClear
      dec  si
      mov  ah,0Fh
      int  10h
      cbw
      int  10h
@@NoClear:

      lea  dx,[si+1]
      mov  ah,9
      int  21h
   end;
   Halt(1);
end;

procedure Init;
var
   PortNum, Error  :Word;
   Timer           :Word absolute 0:$46C;
   LTimer          :Word;
begin
   asm
      mov  dx,word ptr CopyrightASCII
      mov  ah,9
      int  21h
   end;

   Val(ParamStr(1), PortNum, Error);
   if (Error<>0) or (PortNum>8) then
      Abort(#1'Specify COM port number on the command line (1 to 8, 0 for local mode)'#13#10'$');
   LocalMode:=(PortNum=0);
   if not LocalMode then
   begin
      Port.Init(PortNum-1);
      if not Port.Initialized then
         Abort(#1'FOSSIL driver not installed'#13#10'$');

      Port.SendString(CopyrightANSI);

      LTimer:=Timer;
      while (Timer>=LTimer) and (Timer-LTimer<18) do;

      SendCharANSI:=SendChar; CDANSI:=CD;
      InitSendANSI;
   end;

   LastExitProc:=ExitProc; ExitProc:=@PortExitProc;
end;

begin
   Init;
end.